home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / netmail / cpt152.zip / CPT-S152.ZIP / CPT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-16  |  4KB  |  113 lines
  1. PROGRAM Conference_Participation_Tracker;
  2. {$IFDEF DPMI}
  3.   {$M 5120} { reduce stack due to few variables }
  4. {$ELSE}
  5.   {$M 5120,0,655360}
  6. {$ENDIF}
  7. {$N-,E- no math support needed}
  8. {$X- function calls may not be discarded}
  9. {$I- disable I/O checking (trap errors by checking IOResult)}
  10.  
  11. USES DOS, CPT_CODE;
  12.  
  13. {$IFDEF DPMI}
  14.   CONST progname='CPT-p';
  15.         mode='protected mode.';
  16. {$ELSE}
  17.   CONST progname='CPT';
  18.         mode='real mode.';
  19. {$ENDIF}
  20.  
  21. VAR
  22.   SavedExitProc: POINTER;
  23.  
  24. {===========================================================================}
  25.  
  26. PROCEDURE CustomExit; FAR; {---- Always exit through here ----}
  27. BEGIN
  28.   ExitProc := SavedExitProc;
  29.   cursorOn;
  30.   IF (ExitCode > 0) THEN BEGIN
  31.     WriteLn (progname+version+'- Free DOS prog: Conference Participation Tracker, '+mode);
  32.     WriteLn (author+lf);
  33.     WriteLn ('Usage: '+progname+' <QWKfile(s)> <CPT file>'+lf);
  34.     WriteLn ('Note:  <CPT file>  is any DOS filename, with an embedded conference number,');
  35.     WriteLn ('                   and with or without a file extension.'+lf);
  36.     WriteLn ('WARNING:           Do NOT use a file created by a program other than CPT!'+lf);
  37.     WriteLn ('Examples:'+lf);
  38.     WriteLn ('    '+progname+' \qwks\panasia.qwk 123');
  39.     WriteLn ('    '+progname+' channel1.qw* cnf_456.mem');
  40.     WriteLn ('    '+progname+' c:\qwk\lun*.qwk c:\conf\mem_78.dat');
  41.     WriteLn ('    '+progname+' *.qwk 90'+lf);
  42.   END;
  43.   IF ErrorAddr <> NIL THEN {If an unanticipated run-time error occured...}
  44.   BEGIN
  45.     WriteLn ('An unanticipated error occurred, please contact DDA with the following data:');
  46.     WriteLn ('Address = ', WordToHex (Seg (ErrorAddr^)), ':', WordToHex (Ofs (ErrorAddr^)));
  47.     WriteLn ('Code    = ', ExitCode);
  48.     ErrorAddr := NIL; {IMPORTANT!!!}
  49.   END
  50.   ELSE
  51.     IF (ExitCode IN [1..254]) THEN
  52.       WriteError (ExitCode);
  53. END;
  54. {===========================================================================}
  55.  
  56. VAR
  57.   MemberInfo  : MemLink;
  58.  
  59.   OrigMems,
  60.   PrevMems,
  61.   Members     : WORD;
  62.   MemFileName : PATHSTR;
  63.  
  64.   QWKpath    : PATHSTR;    { QWK file path.          }
  65.   QWKdir     : DIRSTR;     { QWK file dir.           }
  66.   dirinfo    : SEARCHREC;  { contains filespec info. }
  67.  
  68. BEGIN
  69.   SavedExitProc := ExitProc;
  70.   ExitProc := @CustomExit;
  71.  
  72.   IF ParamCount <> 2 THEN Halt (255);
  73.  
  74.   MemFileName := GetConfNUMBER (ParamStr (2));
  75.   WriteLn (progname, ' - Conference Participation Tracker, ', mode);
  76.   WriteLn (progname, version, 'updating ', MemFileName);
  77.   Write ('Checking memory available for data ... done!'); WriteMemAvail;
  78.   Members := BuildList (MemberInfo, MemFileName); WriteMemAvail;
  79.   WriteLn ('There are ',Members, ' participants to begin with.');
  80.   OrigMems := Members;
  81.  
  82.   QWKpath := GetFilePath (ParamStr (1), QWKdir);
  83.   FindFirst (QWKpath, Archive, dirinfo); IF DosError <> 0 THEN Halt (2);
  84.   WHILE DosError = 0 DO
  85.   BEGIN
  86.     QWKpath := QWKdir + dirinfo. Name;
  87.     Write ('Reading ', QWKpath, ' ... ');
  88.     EraseFile (DATFileName);
  89.     ExCMD := IsArchive (QWKpath);
  90.     IF ExtractFile (QWKpath, DATfileName, ExCMD) THEN
  91.     BEGIN
  92.       IF CONFname = '' THEN
  93.         CONFname := GetCONFname (QWKpath, CNFFileName);
  94.       PrevMems := Members;
  95.       Members := Members + ReadDAT (MemberInfo, DATFileName);
  96.       Write ('done!');  WriteMemAvail;
  97.       WriteLn ('Added ',Members - PrevMems,' new participant(s) this packet, now there are ',Members,' total.');
  98.       EraseFile (DATFileName);
  99.     END
  100.     ELSE
  101.       WriteLn ('no MESSAGES.DAT - skipping.');
  102.     FindNext (dirinfo);
  103.   END;
  104.  
  105.   IF MemberInfo <> NIL THEN BEGIN
  106. {   GetSortField ('NAME');                        }
  107. {   SortLinkedList (MemberInfo); WriteMemAvail;   }
  108.     WriteList (MemberInfo, MemFileName, Members); WriteMemAvail;
  109.   END;
  110.   WriteLn ('Added ',Members - OrigMems,' new participant(s) this session, now there are ',Members,' total.');
  111.   WriteLn ('Mission accomplished!');
  112. END.
  113.